?? speedbar.pas
字號:
Result := FButton.Action;
end;
procedure TSpeedItem.SetAction(Value: TBasicAction);
begin
FButton.Action := Value;
end;
{$ENDIF}
procedure TSpeedItem.ButtonClick;
begin
FButton.ButtonClick;
end;
function TSpeedItem.CheckBtnMenuDropDown: Boolean;
begin
Result := FButton.CheckBtnMenuDropDown;
end;
procedure TSpeedItem.Click;
begin
FButton.Click;
end;
function TSpeedItem.GetTag: Longint;
begin
Result := inherited Tag;
end;
procedure TSpeedItem.SetTag(Value: Longint);
begin
inherited Tag := Value;
FButton.Tag := Value;
end;
function TSpeedItem.GetDropDownMenu: TPopupMenu;
begin
Result := FButton.DropDownMenu;
end;
procedure TSpeedItem.SetDropDownMenu(Value: TPopupMenu);
begin
FButton.DropDownMenu := Value;
end;
function TSpeedItem.GetMarkDropDown: Boolean;
begin
Result := FButton.MarkDropDown;
end;
procedure TSpeedItem.SetMarkDropDown(Value: Boolean);
begin
FButton.MarkDropDown := Value;
end;
function TSpeedItem.GetWordWrap: Boolean;
begin
Result := FButton.WordWrap;
end;
procedure TSpeedItem.SetWordWrap(Value: Boolean);
begin
FButton.WordWrap := Value;
end;
function TSpeedItem.GetLeft: Integer;
begin
Result := FButton.Left;
end;
function TSpeedItem.GetTop: Integer;
begin
Result := FButton.Top;
end;
procedure TSpeedItem.SetLeft(Value: Integer);
begin
FButton.Left := Value;
end;
procedure TSpeedItem.SetTop(Value: Integer);
begin
FButton.Top := Value;
end;
{ TSpeedBar }
const
InternalVer = 1;
constructor TSpeedBar.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FSections := TList.Create;
FButtonSize := DefaultButtonSize;
FButtonStyle := bsNew;
FWallpaper := TPicture.Create;
FWallpaper.OnChange := WallpaperChanged;
FIniLink := TIniLink.Create;
FIniLink.OnSave := IniSave;
FIniLink.OnLoad := IniLoad;
FOffset.X := MinButtonsOffset;
FOffset.Y := FOffset.X;
Height := 2 * FOffset.Y + DefaultButtonSize.Y;
FRowCount := 1;
FEditWin := 0;
FOptions := [sbAllowDrag, sbGrayedBtns];
ControlStyle := ControlStyle - [csSetCaption
{$IFDEF WIN32}, csReplicatable {$ENDIF}];
ParentShowHint := False;
ShowHint := True;
SetFontDefault;
inherited Align := alTop;
FAlign := alTop;
UpdateGridSize;
{$IFDEF WIN32}
FImageChangeLink := TChangeLink.Create;
FImageChangeLink.OnChange := ImageListChange;
{$ENDIF}
if not Registered then begin
RegisterClasses([TSpeedItem, TSpeedbarSection, TSpeedbarButton]);
Registered := True;
end;
end;
destructor TSpeedBar.Destroy;
begin
FOnVisibleChanged := nil;
FOnApplyAlign := nil;
FOnPosChanged := nil;
FIniLink.Free;
FWallpaper.OnChange := nil;
FWallpaper.Free;
FWallpaper := nil;
if FEditWin <> 0 then begin
SendMessage(FEditWin, CM_SPEEDBARCHANGED, SBR_DESTROYED, Longint(Self));
FEditWin := 0;
end;
ClearSections;
FSections.Free;
{$IFDEF WIN32}
FImageChangeLink.Free;
{$ENDIF}
inherited Destroy;
end;
procedure TSpeedBar.Loaded;
begin
inherited Loaded;
if (FReserved = 0) and FFix then begin { fix previous version error }
inherited Align := alTop;
FAlign := alTop;
end;
UpdateGridSize;
ForEachItem(SetItemButtonSize, 0);
end;
procedure TSpeedBar.ReadData(Reader: TReader);
begin
FReserved := Reader.ReadInteger;
end;
procedure TSpeedBar.WriteData(Writer: TWriter);
begin
Writer.WriteInteger(InternalVer);
end;
procedure TSpeedBar.ReadAllowDrag(Reader: TReader);
begin
if Reader.ReadBoolean then Options := Options + [sbAllowDrag]
else Options := Options - [sbAllowDrag];
end;
procedure TSpeedBar.ReadDesignStyle(Reader: TReader);
begin
FDesignStyle := Reader.ReadBoolean;
end;
procedure TSpeedBar.WriteDesignStyle(Writer: TWriter);
begin
Writer.WriteBoolean(NewStyleControls);
end;
procedure TSpeedBar.ReadSections(Reader: TReader);
var
{$IFDEF WIN32}
TmpList: TStrings;
I: Integer;
{$ELSE}
S: string;
{$ENDIF}
begin
{$IFDEF WIN32}
TmpList := TStringList.Create;
try
Reader.ReadListBegin;
while not Reader.EndOfList do
TmpList.AddObject(Reader.ReadString, nil);
Reader.ReadListEnd;
if (Reader.Ancestor = nil) or (TmpList.Count > 0) then begin
for I := 0 to TmpList.Count - 1 do begin
if SearchSection(TmpList[I]) < 0 then AddSection(TmpList[I]);
end;
end;
finally
TmpList.Free;
end;
{$ELSE}
Reader.ReadListBegin;
FSections.Clear;
while not Reader.EndOfList do begin
S := Reader.ReadString;
if SearchSection(S) < 0 then AddSection(S);
end;
Reader.ReadListEnd;
{$ENDIF}
end;
procedure TSpeedBar.WriteSections(Writer: TWriter);
var
I: Integer;
begin
Writer.WriteListBegin;
for I := 0 to FSections.Count - 1 do
Writer.WriteString(Sections[I].Caption);
Writer.WriteListEnd;
end;
procedure TSpeedBar.DefineProperties(Filer: TFiler);
begin
inherited DefineProperties(Filer);
Filer.DefineProperty('Sections', ReadSections, WriteSections, False);
Filer.DefineProperty('NewStyle', ReadDesignStyle, WriteDesignStyle, False);
Filer.DefineProperty('InternalVer', ReadData, WriteData,
{$IFDEF WIN32} Filer.Ancestor = nil {$ELSE} True {$ENDIF});
{ AllowDrag reading for backward compatibility only }
Filer.DefineProperty('AllowDrag', ReadAllowDrag, nil, False);
end;
function TSpeedBar.GetSection(Index: Integer): TSpeedbarSection;
begin
Result := TSpeedbarSection(FSections[Index]);
end;
function TSpeedBar.GetSectionCount: Integer;
begin
Result := FSections.Count;
end;
procedure TSpeedBar.ForEachItem(Proc: TForEachItem; Data: Longint);
var
I, Idx: Integer;
Sect: TSpeedbarSection;
begin
for I := 0 to FSections.Count - 1 do
if FSections[I] <> nil then begin
Sect := TSpeedbarSection(FSections[I]);
for Idx := 0 to Sect.Count - 1 do begin
if (Sect[Idx] <> nil) and Assigned(Proc) then
Proc(TSpeedItem(Sect[Idx]), Data);
end;
end;
end;
function TSpeedBar.MinButtonsOffset: Integer;
begin
Result := BorderWidth + 2 * Ord(not (sbFlatBtns in Options));
if BevelOuter <> bvNone then Inc(Result, BevelWidth);
if BevelInner <> bvNone then Inc(Result, BevelWidth);
end;
procedure TSpeedBar.SetItemVisible(Item: TSpeedItem; Data: Longint);
var
ItemVisible: Boolean;
begin
ItemVisible := Item.Visible and Self.Visible;
Item.FButton.Visible := ItemVisible;
if (Item.FButton.Parent <> Self) and ItemVisible then
Item.FButton.Parent := Self;
end;
procedure TSpeedBar.SetItemEnabled(Item: TSpeedItem; Data: Longint);
begin
Item.FButton.Enabled := Item.Enabled and Self.Enabled;
end;
procedure TSpeedBar.SetItemButtonSize(Item: TSpeedItem; Data: Longint);
begin
ApplyItemSize(Item, Data);
Item.Visible := Item.Visible; { update visible and parent after loading }
end;
procedure TSpeedBar.SwapItemBounds(Item: TSpeedItem; Data: Longint);
begin
Item.FButton.SetBounds(Item.Top, Item.Left, FButtonSize.X, FButtonSize.Y);
end;
procedure TSpeedBar.SetFontDefault;
{$IFDEF WIN32}
var
NCMetrics: TNonClientMetrics;
{$ENDIF}
begin
ParentFont := False;
with Font do begin
{$IFDEF WIN32}
NCMetrics.cbSize := SizeOf(TNonClientMetrics);
if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NCMetrics, 0) then
begin
Handle := CreateFontIndirect(NCMetrics.lfMenuFont);
{$IFNDEF VER90}
Charset := DEFAULT_CHARSET;
{$ENDIF}
end
else begin
{$ENDIF}
Name := 'MS Sans Serif';
Size := 8;
Style := [];
Color := clBtnText;
{$IFDEF WIN32}
end;
{$ENDIF}
end;
end;
procedure TSpeedBar.CMVisibleChanged(var Message: TMessage);
begin
inherited;
if not (csLoading in ComponentState) then ForEachItem(SetItemVisible, 0);
if Assigned(FOnVisibleChanged) then FOnVisibleChanged(Self);
end;
procedure TSpeedBar.CMEnabledChanged(var Message: TMessage);
begin
inherited;
if not ((csLoading in ComponentState) or (csDesigning in ComponentState)) then
ForEachItem(SetItemEnabled, 0);
end;
procedure TSpeedBar.WallpaperChanged(Sender: TObject);
begin
Invalidate;
end;
procedure TSpeedBar.SetWallpaper(Value: TPicture);
begin
FWallpaper.Assign(Value);
end;
procedure TSpeedBar.ClearSections;
begin
while FSections.Count > 0 do RemoveSection(FSections.Count - 1);
FSections.Clear;
end;
function TSpeedBar.Items(Section, Index: Integer): TSpeedItem;
var
List: TSpeedbarSection;
begin
Result := nil;
if (Section >= 0) and (Section < FSections.Count) then begin
List := Sections[Section];
if List <> nil then
if (Index >= 0) and (Index < List.Count) then
Result := List[Index];
end;
end;
function TSpeedBar.ItemsCount(Section: Integer): Integer;
begin
Result := 0;
if (Section >= 0) and (Section < FSections.Count) then begin
if FSections[Section] <> nil then
Result := Sections[Section].Count;
end;
end;
procedure TSpeedBar.RemoveSection(Section: Integer);
var
Sect: TSpeedbarSection;
Item: TSpeedItem;
begin
Sect := Sections[Section];
if Sect <> nil then begin
while Sect.Count > 0 do begin
Item := Sect[0];
Item.Free;
end;
Sect.FParent := nil;
Sect.Free;
FSections[Section] := nil;
end;
FSections.Delete(Section);
end;
procedure TSpeedBar.DeleteSection(Section: Integer);
var
Sect: TSpeedbarSection;
I: Integer;
begin
Sect := Sections[Section];
if Sect <> nil then begin
for I := 0 to Sect.Count - 1 do RemoveItem(TSpeedItem(Sect[I]));
Sect.FParent := nil;
FSections[Section] := nil;
end;
FSections.Delete(Section);
end;
procedure TSpeedBar.RemoveItem(Item: TSpeedItem);
var
I, Index: Integer;
begin
if FindItem(Item, I, Index) then begin
Item.FButton.Parent := nil;
Item.FParent := nil;
Item.FSection := -1;
Sections[I].FList.Delete(Index);
end;
end;
function TSpeedBar.SearchSection(const ACaption: string): Integer;
var
I: Integer;
begin
Result := -1;
for I := 0 to FSections.Count - 1 do
if Sections[I].Caption = ACaption then begin
Result := I;
Exit;
end;
end;
function TSpeedBar.AppendSection(Value: TSpeedbarSection): Integer;
var
UniqueName: string;
I: Integer;
begin
I := 0;
UniqueName := Value.Caption;
while SearchSection(UniqueName) >= 0 do begin
Inc(I);
UniqueName := Value.Caption + Format(' (%d)', [I]);
end;
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -