Browse Source

Rescue files from #390.

Martijn Laan 4 years ago
parent
commit
b0ed2d55fc

+ 49 - 0
Components/NewCheckListBox.pas

@@ -37,6 +37,8 @@ type
     SubItem: string;
     SubItem: string;
     ThreadCache: set of Byte;
     ThreadCache: set of Byte;
     MeasuredHeight: Integer;
     MeasuredHeight: Integer;
+    ItemFontStyle: TFontStyles;
+    SubItemFontStyle: TFontStyles;
   end;
   end;
 
 
   TCheckItemOperation = (coUncheck, coCheck, coCheckWithChildren); 
   TCheckItemOperation = (coUncheck, coCheck, coCheckWithChildren); 
@@ -112,6 +114,8 @@ type
     function GetLevel(Index: Integer): Byte;
     function GetLevel(Index: Integer): Byte;
     function GetObject(Index: Integer): TObject;
     function GetObject(Index: Integer): TObject;
     function GetState(Index: Integer): TCheckBoxState;
     function GetState(Index: Integer): TCheckBoxState;
+    function GetItemFont(Index: Integer): TFontStyles;
+    function GetSubItemFont(Index: Integer): TFontStyles;
     function GetSubItem(Index: Integer): string;
     function GetSubItem(Index: Integer): string;
     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
     procedure KeyUp(var Key: Word; Shift: TShiftState); override;
     procedure KeyUp(var Key: Word; Shift: TShiftState); override;
@@ -125,6 +129,8 @@ type
     procedure SetFlat(Value: Boolean);
     procedure SetFlat(Value: Boolean);
     procedure SetItemEnabled(Index: Integer; const AEnabled: Boolean);
     procedure SetItemEnabled(Index: Integer; const AEnabled: Boolean);
     procedure SetObject(Index: Integer; const AObject: TObject);
     procedure SetObject(Index: Integer; const AObject: TObject);
+    procedure SetItemFont(Index: Integer; const AItemFontStyle: TFontStyles);
+    procedure SetSubItemFont(Index: Integer; const ASubItemFontStyle: TFontStyles);
     procedure SetOffset(AnOffset: Integer);
     procedure SetOffset(AnOffset: Integer);
     procedure SetShowLines(Value: Boolean);
     procedure SetShowLines(Value: Boolean);
     procedure SetSubItem(Index: Integer; const ASubItem: String);
     procedure SetSubItem(Index: Integer; const ASubItem: String);
@@ -151,6 +157,8 @@ type
     property ItemObject[Index: Integer]: TObject read GetObject write SetObject;
     property ItemObject[Index: Integer]: TObject read GetObject write SetObject;
     property ItemSubItem[Index: Integer]: string read GetSubItem write SetSubItem;
     property ItemSubItem[Index: Integer]: string read GetSubItem write SetSubItem;
     property State[Index: Integer]: TCheckBoxState read GetState;
     property State[Index: Integer]: TCheckBoxState read GetState;
+    property ItemFontStyle[Index: Integer]: TFontStyles read GetItemFont write SetItemFont;
+    property SubItemFontStyle[Index: Integer]: TFontStyles read GetSubItemFont write SetSubItemFont;
   published
   published
     property Align;
     property Align;
     property Anchors;
     property Anchors;
@@ -756,6 +764,7 @@ var
   SubItemWidth: Integer;
   SubItemWidth: Integer;
   PartId, StateId: Integer;
   PartId, StateId: Integer;
   Size: TSize;
   Size: TSize;
+  BitFStyle: Byte;
 begin
 begin
   if FShowLines and not FThreadsUpToDate then begin
   if FShowLines and not FThreadsUpToDate then begin
     UpdateThreads;
     UpdateThreads;
@@ -856,6 +865,15 @@ begin
     OldColor := SetTextColor(Handle, ColorToRGB(NewTextColor));
     OldColor := SetTextColor(Handle, ColorToRGB(NewTextColor));
     if ItemState.SubItem <> '' then
     if ItemState.SubItem <> '' then
     begin
     begin
+
+      { Set Font Style for SubItem }
+      BitFStyle := 0;
+      if (fsBold in ItemState.SubItemFontStyle) then inc(BitFStyle, 1);
+      if (fsItalic in ItemState.SubItemFontStyle) then inc(BitFStyle, 2);
+      if (fsUnderline in ItemState.SubItemFontStyle) then inc(BitFStyle, 4);
+      if (fsStrikeOut in ItemState.SubItemFontStyle) then inc(BitFStyle, 8);
+      Font.Style := TFontStyles(BitFStyle);
+
       DrawTextFormat := DT_NOCLIP or DT_NOPREFIX or DT_SINGLELINE or DT_VCENTER;
       DrawTextFormat := DT_NOCLIP or DT_NOPREFIX or DT_SINGLELINE or DT_VCENTER;
       if FUseRightToLeft then
       if FUseRightToLeft then
         DrawTextFormat := DrawTextFormat or (DT_RIGHT or DT_RTLREADING);
         DrawTextFormat := DrawTextFormat or (DT_RIGHT or DT_RTLREADING);
@@ -892,6 +910,15 @@ begin
       measuring, pass our rectangle to DrawText with DT_CALCRECT first.
       measuring, pass our rectangle to DrawText with DT_CALCRECT first.
       Wrapping at the same place is important because it can affect how many
       Wrapping at the same place is important because it can affect how many
       lines are drawn -- and we mustn't draw too many. }
       lines are drawn -- and we mustn't draw too many. }
+
+    { Set Font Style for SubItem }
+    BitFStyle := 0;
+    if (fsBold in ItemState.ItemFontStyle) then inc(BitFStyle, 1);
+    if (fsItalic in ItemState.ItemFontStyle) then inc(BitFStyle, 2);
+    if (fsUnderline in ItemState.ItemFontStyle) then inc(BitFStyle, 4);
+    if (fsStrikeOut in ItemState.ItemFontStyle) then inc(BitFStyle, 8);
+    Font.Style := TFontStyles(BitFStyle);
+
     InternalDrawText(Items[Index], Rect, DrawTextFormat or DT_CALCRECT, False);
     InternalDrawText(Items[Index], Rect, DrawTextFormat or DT_CALCRECT, False);
     FlipRect(Rect, SavedClientRect, FUseRightToLeft);
     FlipRect(Rect, SavedClientRect, FUseRightToLeft);
     InternalDrawText(Items[Index], Rect, DrawTextFormat, FWantTabs and Disabled);
     InternalDrawText(Items[Index], Rect, DrawTextFormat, FWantTabs and Disabled);
@@ -985,6 +1012,8 @@ begin
     ItemState.Obj := AObject;
     ItemState.Obj := AObject;
     ItemState.Level := ALevel;
     ItemState.Level := ALevel;
     ItemState.SubItem := ASubItem;
     ItemState.SubItem := ASubItem;
+    ItemState.ItemFontStyle := [];
+    ItemState.SubItemFontStyle := [];
     ItemState.HasInternalChildren := AHasInternalChildren;
     ItemState.HasInternalChildren := AHasInternalChildren;
     ItemState.CheckWhenParentChecked := ACheckWhenParentChecked;
     ItemState.CheckWhenParentChecked := ACheckWhenParentChecked;
   except
   except
@@ -1101,6 +1130,16 @@ begin
   Result := ItemStates[Index].State;
   Result := ItemStates[Index].State;
 end;
 end;
 
 
+function TNewCheckListBox.GetItemFont(Index: Integer): TFontStyles;
+begin
+  Result := ItemStates[Index].ItemFontStyle;
+end;
+
+function TNewCheckListBox.GetSubItemFont(Index: Integer): TFontStyles;
+begin
+  Result := ItemStates[Index].SubItemFontStyle;
+end;
+
 function TNewCheckListBox.GetSubItem(Index: Integer): String;
 function TNewCheckListBox.GetSubItem(Index: Integer): String;
 begin
 begin
   Result := ItemStates[Index].SubItem;
   Result := ItemStates[Index].SubItem;
@@ -1486,6 +1525,16 @@ begin
   ItemStates[Index].Obj := AObject;
   ItemStates[Index].Obj := AObject;
 end;
 end;
 
 
+procedure TNewCheckListBox.SetItemFont(Index: Integer; const AItemFontStyle: TFontStyles);
+begin
+  ItemStates[Index].ItemFontStyle := AItemFontStyle;
+end;
+
+procedure TNewCheckListBox.SetSubItemFont(Index: Integer; const ASubItemFontStyle: TFontStyles);
+begin
+  ItemStates[Index].SubItemFontStyle := ASubItemFontStyle;
+end;
+
 procedure TNewCheckListBox.SetOffset(AnOffset: Integer);
 procedure TNewCheckListBox.SetOffset(AnOffset: Integer);
 begin
 begin
   if FOffset <> AnOffset then
   if FOffset <> AnOffset then

+ 2 - 0
ISHelp/isxclasses.pas

@@ -546,6 +546,8 @@ TNewCheckListBox = class(TCustomListBox)
   property ItemLevel[Index: Integer]: Byte; read;
   property ItemLevel[Index: Integer]: Byte; read;
   property ItemObject[Index: Integer]: TObject; read write;
   property ItemObject[Index: Integer]: TObject; read write;
   property ItemSubItem[Index: Integer]: String; read write;
   property ItemSubItem[Index: Integer]: String; read write;
+  property ItemFontStyle[Index: Integer]: TFontStyles; read write;
+  property SubItemFontStyle[Index: Integer]: TFontStyles; read write;
   property Flat: Boolean; read write;
   property Flat: Boolean; read write;
   property MinItemHeight: Integer; read write;
   property MinItemHeight: Integer; read write;
   property Offset: Integer; read write;
   property Offset: Integer; read write;

+ 3 - 1
Projects/ScriptClasses_C.pas

@@ -2,7 +2,7 @@ unit ScriptClasses_C;
 
 
 {
 {
   Inno Setup
   Inno Setup
-  Copyright (C) 1997-2019 Jordan Russell
+  Copyright (C) 1997-2020 Jordan Russell
   Portions by Martijn Laan
   Portions by Martijn Laan
   For conditions of distribution and use, see LICENSE.TXT.
   For conditions of distribution and use, see LICENSE.TXT.
 
 
@@ -86,6 +86,8 @@ begin
     RegisterProperty('ItemLevel', 'Byte Integer', iptr);
     RegisterProperty('ItemLevel', 'Byte Integer', iptr);
     RegisterProperty('ItemObject', 'TObject Integer', iptrw);
     RegisterProperty('ItemObject', 'TObject Integer', iptrw);
     RegisterProperty('ItemSubItem', 'String Integer', iptrw);
     RegisterProperty('ItemSubItem', 'String Integer', iptrw);
+    RegisterProperty('ItemFontStyle', 'TFontStyles Integer', iptrw);
+    RegisterProperty('SubItemFontStyle', 'TFontStyles Integer', iptrw);
     RegisterProperty('Flat', 'Boolean', iptrw);
     RegisterProperty('Flat', 'Boolean', iptrw);
     RegisterProperty('MinItemHeight', 'Integer', iptrw);
     RegisterProperty('MinItemHeight', 'Integer', iptrw);
     RegisterProperty('Offset', 'Integer', iptrw);
     RegisterProperty('Offset', 'Integer', iptrw);

+ 7 - 1
Projects/ScriptClasses_R.pas

@@ -2,7 +2,7 @@ unit ScriptClasses_R;
 
 
 {
 {
   Inno Setup
   Inno Setup
-  Copyright (C) 1997-2019 Jordan Russell
+  Copyright (C) 1997-2020 Jordan Russell
   Portions by Martijn Laan
   Portions by Martijn Laan
   For conditions of distribution and use, see LICENSE.TXT.
   For conditions of distribution and use, see LICENSE.TXT.
 
 
@@ -66,6 +66,10 @@ procedure TNewCheckListBoxItemObject_R(Self: TNewCheckListBox; var T: TObject; t
 procedure TNewCheckListBoxItemObject_W(Self: TNewCheckListBox; const T: TObject; t1: Integer); begin Self.ItemObject[t1] := T; end;
 procedure TNewCheckListBoxItemObject_W(Self: TNewCheckListBox; const T: TObject; t1: Integer); begin Self.ItemObject[t1] := T; end;
 procedure TNewCheckListBoxItemSubItem_R(Self: TNewCheckListBox; var T: String; t1: Integer); begin T := Self.ItemSubItem[t1]; end;
 procedure TNewCheckListBoxItemSubItem_R(Self: TNewCheckListBox; var T: String; t1: Integer); begin T := Self.ItemSubItem[t1]; end;
 procedure TNewCheckListBoxItemSubItem_W(Self: TNewCheckListBox; const T: String; t1: Integer); begin Self.ItemSubItem[t1] := T; end;
 procedure TNewCheckListBoxItemSubItem_W(Self: TNewCheckListBox; const T: String; t1: Integer); begin Self.ItemSubItem[t1] := T; end;
+procedure TNewCheckListBoxItemFontStyle_R(Self: TNewCheckListBox; var T: TFontStyles; const t1: Integer); begin T := Self.ItemFontStyle[t1]; end;
+procedure TNewCheckListBoxItemFontStyle_W(Self: TNewCheckListBox; const T: TFontStyles; const t1: Integer); begin Self.ItemFontStyle[t1] := T; end;
+procedure TNewCheckListBoxSubItemFontStyle_R(Self: TNewCheckListBox; var T: TFontStyles; const t1: Integer); begin T := Self.SubItemFontStyle[t1]; end;
+procedure TNewCheckListBoxSubItemFontStyle_W(Self: TNewCheckListBox; const T: TFontStyles; const t1: Integer); begin Self.SubItemFontStyle[t1] := T; end;
 
 
 procedure RegisterNewCheckListBox_R(Cl: TPSRuntimeClassImporter);
 procedure RegisterNewCheckListBox_R(Cl: TPSRuntimeClassImporter);
 begin
 begin
@@ -82,6 +86,8 @@ begin
     RegisterPropertyHelper(@TNewCheckListBoxItemLevel_R, nil, 'ItemLevel');
     RegisterPropertyHelper(@TNewCheckListBoxItemLevel_R, nil, 'ItemLevel');
     RegisterPropertyHelper(@TNewCheckListBoxItemObject_R, @TNewCheckListBoxItemObject_W, 'ItemObject');
     RegisterPropertyHelper(@TNewCheckListBoxItemObject_R, @TNewCheckListBoxItemObject_W, 'ItemObject');
     RegisterPropertyHelper(@TNewCheckListBoxItemSubItem_R, @TNewCheckListBoxItemSubItem_W, 'ItemSubItem');
     RegisterPropertyHelper(@TNewCheckListBoxItemSubItem_R, @TNewCheckListBoxItemSubItem_W, 'ItemSubItem');
+    RegisterPropertyHelper(@TNewCheckListBoxItemFontStyle_R, @TNewCheckListBoxItemFontStyle_W, 'ItemFontStyle');
+    RegisterPropertyHelper(@TNewCheckListBoxSubItemFontStyle_R, @TNewCheckListBoxSubItemFontStyle_W, 'SubItemFontStyle');
   end;
   end;
 end;
 end;